-- -- Copyright 2014 Alessandro Gerlinger Romero -- -- This file is part of Hybrid fUML. -- -- Hybrid fUML is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- Hybrid fUML is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Hybrid fUML. If not, see . -- ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- APPROACH -- These classes exist for definition of behavior, i.e. mapping from abstract syntax to semantic domain -- FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -- FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance -- NOT IMPLEMENTED HERE -- Rationale: they demand a effort for data construction of elements that are not usefull (in current approach to embed semantic domain in a functional language as Haskell or Gofer) -- -- -- THEREFORE: -- functions are defined to offer and held tokens -- using alias for tuples of types (value, activityedge or activitynode) -- value indicates what is the activity manipulating the data, if it was used only the syntactical element only one copy each time can be executed -- none of the classes used to wrap the classes from abstract syntax are used, e.g. ActivityNodeActivationGroup, ActivityEdgeInstance, ActivityNodeActivation -- FROM SEMANTIC DOMAIN ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation type FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation = (FUML_Semantics_Classes_Kernel_Value, FUML_Syntax_Activities_IntermediateActivities_ActivityNode) -- AsmTerm already defined for tuples up to 4 elements, vide tk.prelude-all-asm.gs function_ActivityNodeActivation_heldTokens :: Dynamic ( FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> {FUML_Semantics_Activities_IntermediateActivities_Token} ) function_ActivityNodeActivation_heldTokens = initAssocs' "function_ActivityNodeActivation_heldTokens" {} asmLt (==) [] function_ActivityNodeActivation_isRunning :: Dynamic ( FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Bool ) function_ActivityNodeActivation_isRunning = initAssocs' "function_ActivityNodeActivation_isRunning" False asmLt (==) [] function_ActivityNodeActivation_isReady :: FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation -> Bool function_ActivityNodeActivation_isReady (vl,an) = if card (function_ActivityNode_Action_input an) == 0 then -- control tokens are enough, no inputs -- if has more than one incomming the number of tokens should be equal, exception is mergenode one token is enough to run (ONLY CONTROL, it does not allow OBJECT) if function_ActivityNode_incoming(an) /= {} && function_ActivityNode_type(an) /= FUML_Syntax_Activities_IntermediateActivities_MergeNode then (length $ expr2list (function_ActivityNodeActivation_heldTokens(vl,an))) == (length $ expr2list (function_ActivityNode_incoming(an))) else (length $ expr2list (function_ActivityNodeActivation_heldTokens(vl,an))) == 1 else -- check if all input pins has tokens, LIMITATION: it does not consider lower and upper -- check all control tokens length (filter (\n -> function_ActivityNodeActivation_heldTokens(vl,n) /= {}) (expr2list (function_ActivityNode_Action_input an))) == length (expr2list (function_ActivityNode_Action_input an)) && length (expr2list $ function_ActivityNodeActivation_heldTokens (vl,an)) == length (expr2list (function_ActivityNode_incoming an)) ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- CLASS FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance type FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance = (FUML_Semantics_Classes_Kernel_Value, FUML_Syntax_Activities_IntermediateActivities_ActivityEdge) -- AsmTerm already defined for tuples up to 4 elements, vide tk.prelude-all-asm.gs function_ActivityEdgeInstance_offers :: Dynamic ( FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance -> {FUML_Semantics_Activities_IntermediateActivities_Offer} ) function_ActivityEdgeInstance_offers = initAssocs' "function_ActivityEdgeInstance_offers" {} asmLt (==) [] ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- DEFINED ------------------------------------------------------------------------------------------------------------------------------------------------------------ ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- COMPUTE TOKEN FLOW SEMANTICS -- return elements (ACTIONS) with controltoken to run or that has all input pins satisfied function_fUML_shouldFire :: FUML_Semantics_Classes_Kernel_Value -> {FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation} function_fUML_shouldFire v | function_Classifier_type(c) == FUML_Syntax_Activities_IntermediateActivities_Activity = mkSet (filter (\(v,n) -> function_ActivityNodeActivation_isReady(v,n) && function_ActivityNode_activity(n) == c && not (function_ActivityNodeActivation_isRunning (v,n)) && (not (function_fUML_isObjectNode n))) (expr2list ns)) | otherwise = error( "function_fUML_shouldFire - unsupported classifiertype " ++ show c) where c = function_fUML_oneClassifierType v -- every node that has tokens or has input node should be verified ns = dom(function_ActivityNodeActivation_heldTokens) `union` ns2 alin = mkSet( concat $ map (\n -> expr2list $ function_ActivityNode_Action_input n) (expr2list $ function_Activity_node c)) ns2 = mkSet( map (\n -> (v,n)) (filter (\n -> (function_ActivityNode_Action_input n) `intersect` alin /= {}) (expr2list $ function_Activity_node c))) -- return edges that should offer function_fUML_shouldOffer :: FUML_Semantics_Classes_Kernel_Value -> {FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance} function_fUML_shouldOffer v | function_Classifier_type(c) == FUML_Syntax_Activities_IntermediateActivities_Activity = if (emptyDom function_ActivityNodeActivation_heldTokens) then {} else mkSet $ map (\e -> (v,e)) $ filter (\e -> function_fUML_isAbleToOffer (v,e) n) (expr2list es) | otherwise = error( "function_fUML_shouldOffer - unsupported classifiertype " ++ show c) where c = function_fUML_oneClassifierType v es = function_Activity_edge(c) n = mkSet ( map (\(v1,n1) -> n1) $ filter (\(v1,n1) -> (function_ActivityNode_activity(n1) == c || (alon `intersect` {n1} /= {})) && v1 == v) (expr2list $ dom $ function_ActivityNodeActivation_heldTokens)) alon = bigUnion (mkSet (map function_ActivityNode_Action_output (expr2list $ function_Activity_node c))) -- given an edge check it its source node is able to offer, it has complete its execution and all output pin (if applicable has at least one pin), and it is not a decision node function_fUML_isAbleToOffer :: FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance -> {FUML_Syntax_Activities_IntermediateActivities_ActivityNode} -> Bool function_fUML_isAbleToOffer (v,e) ns = not $ null $ filter (\n -> ((function_ActivityNode_outgoing n) `intersect` {e}) /= {} && function_ActivityNode_type(n) /= FUML_Syntax_Activities_IntermediateActivities_DecisionNode && ( ((card $ function_ActivityNode_Action_output n) == (length $ filter (\(v1,n1) -> (function_ActivityNode_Action_output n) `intersect` {n1} /= {} && v1 == v) (expr2list $ dom $ function_ActivityNodeActivation_heldTokens))) || (function_ActivityNodeActivation_isRunning (v,n) && function_fUML_isAction(n)) ) ) (expr2list ns) -- -- return edges that should offer prioritized: the edges that has as target a node that will suspend an activity should be the last -- it should not be necessary, however, due to the absence of internal concurrency this is needed (vide zerocrossing example) -- function_fUML_shouldOfferPrioritized :: FUML_Semantics_Classes_Kernel_Value -> [FUML_Semantics_Activities_IntermediateActivities_ActivityEdgeInstance] function_fUML_shouldOfferPrioritized v -- simple order for scheduler due to the absence of parallel features inside an active class -- firstly, the nodes that cannot cause suspension of activity -- finally, pause (it will mark the activity to be evaluated in the next reaction) = filter (\(_,e) -> not (function_fUML_activityNodeWillSuspend (function_ActivityEdge_target e))) (expr2list $ function_fUML_shouldOffer v) ++ filter (\(_,e) -> (function_fUML_activityNodeWillSuspend (function_ActivityEdge_target e))) (expr2list $ function_fUML_shouldOffer v) -- return the nodes that can take an offer function_fUML_shouldTakeOffer :: FUML_Semantics_Classes_Kernel_Value -> {FUML_Semantics_Activities_IntermediateActivities_ActivityNodeActivation} function_fUML_shouldTakeOffer v | function_Classifier_type(c) == FUML_Syntax_Activities_IntermediateActivities_Activity = if (emptyDom function_ActivityEdgeInstance_offers) then {} else mkSet $ map (\n -> (v,n)) $filter (\n -> ((function_ActivityNode_incoming(n)) `intersect` e) /= {}) (expr2list ns) | otherwise = error( "function_fUML_shouldTakeOffer - unsupported classifiertype " ++ show c) where ns = function_Activity_node(c) `union` alin e = mkSet $ map (\(v1,e)-> e) $ filter (\(v1,e) -> v1 == v) $ expr2list $ dom function_ActivityEdgeInstance_offers alin = bigUnion (mkSet (map function_ActivityNode_Action_input (expr2list $ function_Activity_node c))) c = function_fUML_oneClassifierType v -- -- these nodes shall receive control tokens function_fUML_initialNodes :: FUML_Syntax_Classes_Kernel_Classifier -> [FUML_Syntax_Activities_IntermediateActivities_ActivityNode] function_fUML_initialNodes act = let ns = expr2list (function_Activity_node act) in filter (\n -> function_ActivityNode_type(n) == FUML_Syntax_Activities_IntermediateActivities_InitialNode) ns ------------------------------------------------------------------------------------------------------------------------------------------------------------ -- HELP FUNCTIONS -- retrives ONE classifier from a given value -- every call to this rule demarks rules that assumes just ONE TYPE -- if it has more than one, there is no way to decide, so it returns classifier empty function_fUML_oneClassifierType :: FUML_Semantics_Classes_Kernel_Value -> FUML_Syntax_Classes_Kernel_Classifier function_fUML_oneClassifierType vl = if vl == FUML_Semantics_Classes_Kernel_ValueEmpty then FUML_Syntax_Classes_Kernel_ClassifierEmpty else case (function_Value_type vl) of FUML_Semantics_CommonBehaviors_Communications_SignalInstance-> function_Value_SignalInstance_type vl FUML_Semantics_Classes_Kernel_DataValue -> function_Value_DataValue_type vl _ -> if card (function_Value_Object_types vl) == 1 then one $ function_Value_Object_types vl else FUML_Syntax_Classes_Kernel_ClassifierEmpty -- check if it is an Object Node function_fUML_isObjectNode :: FUML_Syntax_Activities_IntermediateActivities_ActivityNode -> Bool function_fUML_isObjectNode n | function_ActivityNode_type(n) == FUML_Syntax_Actions_BasicActions_InputPin = True --| function_ActivityNode_type(n) == FUML_Syntax_Activities_IntermediateActivities_ActivityParameterNode = True | function_ActivityNode_type(n) == FUML_Syntax_Actions_BasicActions_OutputPin = True | otherwise = False -- check if a given activitynode can suspend an activityexecution -- stereotyped as edge and accepteventaction function_fUML_activityNodeCanSuspend :: FUML_Syntax_Activities_IntermediateActivities_ActivityNode -> Bool function_fUML_activityNodeCanSuspend an = function_fUML_stereotypedActivityNode Edge an || (function_ActivityNode_type(an) == FUML_Syntax_Actions_CompleteActions_AcceptEventAction) -- check if a given activitynode will suspend an activityexecution -- stereotyped as pausable function_fUML_activityNodeWillSuspend :: FUML_Syntax_Activities_IntermediateActivities_ActivityNode -> Bool function_fUML_activityNodeWillSuspend an = function_fUML_stereotypedActivityNode Pausable an -- -- STEREOTYPES -- check if a given stereotype is applied in a given activitynode function_fUML_stereotypedActivityNode :: Stereotype -> FUML_Syntax_Activities_IntermediateActivities_ActivityNode -> Bool function_fUML_stereotypedActivityNode st an = (function_ActivityNode_AppliedStereotype an) `intersect` {st} /= {}